home *** CD-ROM | disk | FTP | other *** search
/ SGI Developer Toolbox 6.1 / SGI Developer Toolbox 6.1 - Disc 1.iso / toolbox / src / exampleCode / opengl / GLUT / progs / fortran / fscene.f < prev    next >
Encoding:
Text File  |  1996-11-11  |  3.1 KB  |  126 lines
  1.  
  2. C  Copyright (c) Mark J. Kilgard, 1994.
  3.  
  4. C  This program is freely distributable without licensing fees
  5. C  and is provided without guarantee or warrantee expressed or
  6. C  implied.  This program is -not- in the public domain.
  7.  
  8. C  GLUT Fortran program to render simple red scene.
  9.  
  10.     subroutine display
  11. #include "GL/fgl.h"
  12.     call fglclear(GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT)
  13.     call fglpushmatrix
  14.     call fglscalef(1.3, 1.3, 1.3)
  15.     call fglrotatef(20.0, 1.0, 0.0, 0.0)
  16.  
  17.     call fglpushmatrix
  18.     call fgltranslatef(-0.75, 0.5, 0.0)
  19.     call fglrotatef(90.0, 1.0, 0.0, 0.0)
  20.     call glutsolidtorus(dble(0.275), dble(0.85), 10, 15)
  21.     call fglpopmatrix
  22.  
  23.     call fglpushmatrix
  24.     call fgltranslatef(-0.75, -0.5, 0.0)
  25.     call fglrotatef(270.0, 1.0, 0.0, 0.0)
  26.     call glutsolidtetrahedron
  27.     call fglpopmatrix
  28.  
  29.     call fglpushmatrix
  30.     call fgltranslatef(0.75, 0.0, -1.0)
  31.     call glutsolidicosahedron
  32.     call fglpopmatrix
  33.  
  34.     call fglpopmatrix
  35.     call fglflush
  36.     end
  37.  
  38.     subroutine reshape(w,h)
  39. #include "GL/fgl.h"
  40.     integer w,h
  41.     real wr,hr
  42.     real*8 d
  43.     call fglviewport(0, 0, w, h)
  44.     call fglmatrixmode(GL_PROJECTION)
  45.     call fglloadidentity
  46.     wr = w
  47.     hr = h
  48.     d = 1.0
  49.     if ( w .le. h ) then
  50.        call fglortho(dble(-2.5), dble(2.5),
  51.      2       dble(-2.5 * hr/wr), dble(2.5 * hr/wr),
  52.      3       dble(-10.0), dble(10.0))
  53.     else
  54.        call fglortho(dble(-2.5 * hr/wr), dble(2.5 * hr/wr),
  55.      2       dble(-2.5), dble(2.5), dble(-10.0), dble(10.0))
  56.     end if
  57.     call fglmatrixmode(GL_MODELVIEW)
  58.     end
  59.     
  60.     subroutine submenu(value)
  61. #include "GL/fgl.h"
  62.     integer value
  63.     if ( value .eq. 1 ) then
  64.       call fglenable(GL_DEPTH_TEST)
  65.       call fglenable(GL_LIGHTING)
  66.       call fgldisable(GL_BLEND)
  67.       call fglpolygonmode(GL_FRONT_AND_BACK, GL_FILL)
  68.         else
  69.       call fgldisable(GL_DEPTH_TEST)
  70.       call fgldisable(GL_LIGHTING)
  71.       call fglcolor3f(1.0, 1.0, 1.0)
  72.       call fglpolygonmode(GL_FRONT_AND_BACK, GL_LINE)
  73.       call fglenable(GL_LINE_SMOOTH)
  74.       call fglenable(GL_BLEND)
  75.       call fglblendfunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA)
  76.     end if
  77.     call glutpostredisplay
  78.     end
  79.  
  80.     subroutine mainmenu(value)
  81.     integer value
  82.     call exit(1)
  83.     end
  84.  
  85.     subroutine myinit
  86. #include "GL/fgl.h"
  87.     real lambient(4), ldiffuse(4), lspecular(4), lposition(4)
  88.     data lambient /0.0, 0.0, 0.0, 1.0/
  89.     data ldiffuse /1.0, 0.0, 0.0, 1.0/
  90.     data lspecular /1.0, 1.0, 1.0, 1.0/
  91.     data lposition /1.0, 1.0, 1.0, 0.0/
  92.  
  93.     call fgllightfv(GL_LIGHT0, GL_AMBIENT, lambient)
  94.     call fgllightfv(GL_LIGHT0, GL_DIFFUSE, ldiffuse)
  95.     call fgllightfv(GL_LIGHT0, GL_SPECULAR, lspecular)
  96.     call fgllightfv(GL_LIGHT0, GL_POSITION, lposition)
  97.     call fglenable(GL_LIGHT0)
  98.     call fgldepthfunc(GL_LESS)
  99.     call fglenable(GL_DEPTH_TEST)
  100.     call fglenable(GL_LIGHTING)
  101.     end
  102.  
  103.     program main
  104. #include "GL/fglut.h"
  105.     external display
  106.     external reshape
  107.     external submenu
  108.     external mainmenu
  109.     call glutinitwindowposition(500,500)
  110.     call glutinitwindowsize(500,500)
  111.     call glutinit
  112.     call glutcreatewindow('Fortran GLUT program')
  113.     call myinit
  114.     call glutdisplayfunc(display)
  115.     call glutreshapefunc(reshape)
  116.     i = glutcreatemenu(submenu)
  117.     call glutaddmenuentry('Filled', 1)
  118.     call glutaddmenuentry('Outline', 2)
  119.     call glutcreatemenu(mainmenu)
  120.     call glutaddsubmenu('Polygon mode', i)
  121.     call glutaddmenuentry('Quit', 666)
  122.     call glutattachmenu(GLUT_RIGHT_BUTTON)
  123.     call glutmainloop
  124.     end
  125.  
  126.